perm filename FASTGS[CMP,SYS] blob sn#014780 filedate 1973-07-03 generic text, type T, neo UTF8
(DECLARE (READ) (READ))

(DFUNC (GETSLOT NO)
 (COND ((NOT (NUMBERP NO)) (COMPERR NOTSLOT-GETSLOT))
       ((GREATERP NO NACS) (PRINTMSG NO) (COMPERR NOTAC-GETSLOT))
       ((GREATERP NO 0) (NTHCDR (SUB1 NO) ACS))
       ((GREATERP (ABS NO) (PDLDEPTH)) (PRINTMSG NO)
				       (COMPERR NOTONPDL-GETSLOT))
       ((NTHCDR (MINUS NO) PDL))))

(PROG NIL LOOP (COND ((NULL (READ)) (RETURN NIL))) (GO LOOP))

(OPS (MOVNS 213000) (SUBI 275000) (JUMPLE 323000) (HRREI 571000))

(LAP GETSLOT SUBR)
	(HRREI 1 -577777 1)
	(JUMPLE 1 NEGATE)
	(SUBI 1 1)
	(MOVE 2 (SPECIAL ACS))
	(JCALL 2 (E NTHCDR))
 NEGATE	(MOVNS 0 1)
	(MOVE 2 (SPECIAL PDL))
	(JCALL 2 (E NTHCDR))
	NIL

(DECLARE (READ) (READ))

(DFUNC (NTHCDR NUM EXP)
       (PROG NIL
	     (COND ((MINUSP NUM) (COMPERR NEGNUM-NTHCDR)))
	LOOP (COND ((ZEROP NUM) (RETURN EXP)))
	     (COND ((ATOM EXP) (COMPERR ATOM-NTHCDR)))
	     (SETQ EXP (CDR EXP))
	     (SETQ NUM (SUB1 NUM))
	     (GO LOOP)))

(PROG NIL LOOP (COND ((NULL (READ)) (RETURN NIL))) (GO LOOP))

(OPS (SOJA 364000))

(LAP NTHCDR SUBR)
 LOOP	(JUMPE 1 END)
	(HRRZ  2 0 2)
	(SOJA 1 LOOP)
 END	(MOVE 1 2)
	(POPJ P)
	NIL